SetCRSsystem Subroutine

private subroutine SetCRSsystem(CRStype, datumType, rs)

Initialize Coordinate Reference System, allocate memory and set parameters to default value if necessary. Subroutine receives as input a CRS type argument

Arguments

Type IntentOptional Attributes Name
integer, intent(in) :: CRStype
integer, intent(in) :: datumType
type(CRS), intent(inout) :: rs

reference system

Source Code

SUBROUTINE SetCRSsystem &
!
( CRStype, datumType, rs )

IMPLICIT NONE
!Arguments with intent(in):
INTEGER, INTENT (IN) :: CRStype
INTEGER, INTENT (IN) :: datumType 

!Arguments with intent(inout)
TYPE(CRS), INTENT (INOUT) :: rs !!reference system
!------------end of declaration------------------------------------------------

!if a previous system was defined, deallocate and send a warning
IF ( ALLOCATED (rs % param ) ) THEN
 DEALLOCATE (rs % param )
 CALL Catch ('warning', 'GeoLib', 'deallocate already defined CRS parameters' )
END IF
IF ( ALLOCATED (rs % description ) ) THEN
  DEALLOCATE (rs % description )
END IF
!Initialize CRS according to reference system
rs % system = CRStype
SELECT CASE (CRStype)
  CASE (GEODETIC)
    rs % name = 'latitude_longitude'
  CASE (UTM)
    rs % name = 'Universal Transverse Mercator'
  CASE (GAUSS_BOAGA)
    rs % name = 'Gauss Boaga'
  CASE (TM)
    rs % name = 'transverse_mercator'
  CASE (HOM)
    rs % name = 'hotine_oblique_mercator'
  CASE (SOC)
    rs % name = 'swiss_oblique_cylindrical'
END SELECT
rs % datum = datumType
rs % ellipsoid = rs % datum % ellipsoid
SELECT CASE ( CRStype )
  CASE ( GEODETIC )
    rs % basic = 4
    ALLOCATE ( rs % param (4) )
    rs % param = null_float
    ALLOCATE ( rs % description (4) )
    rs % description = null_string
  CASE ( UTM )
    rs % basic = 7
    ALLOCATE ( rs % param (8) )
    rs % param = null_float
    ALLOCATE ( rs % description (8) )
    rs % description = null_string
  CASE (GAUSS_BOAGA)
    rs % basic = 6
    ALLOCATE ( rs % param (7) )
    rs % param = null_float
    ALLOCATE ( rs % description (7) )
    rs % description = null_string
    !datum is set to Monte Mario
    IF (datumType /= ROME40 ) THEN
      rs % datum = ROME40
      rs % ellipsoid = rs % datum % ellipsoid
      CALL Catch ('warning', 'GeoLib',  &
         'Gauss Boaga Datum was set to Monte Mario')
    END IF
  CASE ( TM )
    rs % basic = 5
    ALLOCATE ( rs % param (5) )
    rs % param = null_float
    ALLOCATE ( rs % description (5) )
    rs % description = null_string
  CASE ( HOM )
    rs % basic = 6
    ALLOCATE ( rs % param (6) )
    rs % param = null_float
    ALLOCATE ( rs % description (6) )
    rs % description = null_string
    
  CASE (SOC)
    rs % basic = 6
    ALLOCATE ( rs % param (6) )
    rs % param = null_float
    ALLOCATE ( rs % description (6) )
    rs % description = null_string
    !datum is set to CH1903
    IF (datumType /= CH1903 ) THEN
      rs % datum = CH1903
      rs % ellipsoid = rs % datum % ellipsoid
      CALL Catch ('warning', 'GeoLib',  &
         'Swiss Datum was set to CH1903')
    END IF
    
  CASE DEFAULT
END SELECT

END SUBROUTINE SetCRSsystem